home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / DITHER.INC < prev    next >
Text File  |  1987-01-13  |  3KB  |  98 lines
  1. {routines and types for doing dithering in colour and in monochrome }
  2.  
  3.  
  4. type dithtype = array[1..4] of integer;
  5.  
  6. const Dither: array[1..4] of dithtype = (
  7.    (11,  5, 15,  1),
  8.    (16,  6,  2,  9),
  9.    ( 3, 10, 14,  8),
  10.    ( 7, 12,  4, 13));
  11.  
  12.  
  13. procedure DITHPLOT (X, Y, Ishade, Color: integer);
  14. { dithered pixel plot command }
  15. var Xmod, Ymod: integer;    { X & Y coords modulo 4. This is the place in }
  16.                             { the dither matrix }
  17. begin
  18.   Xmod := X mod 4 + 1;
  19.   Ymod := Y mod 4 + 1;
  20.   if (Ishade >= Dither[Xmod][Ymod]) then
  21.     gplot (X, Y, Color)
  22.   else
  23.     gplot (X, Y, 0);
  24. end; { procedure DITHPLOT }
  25.  
  26.  
  27. procedure DITHDRAW (X1, X2, Y, Ishade, Color: integer);
  28. { dithered horizontal line drawing routine }
  29. var X:          integer;        { X coord along line }
  30. var Xmod, Ymod: integer;    { X & Y coords modulo 4. This is the place in }
  31.                             { the dither matrix }
  32.  
  33. begin
  34.   Ymod := Y mod 4 + 1;
  35.   for X := X1 to X2 do begin
  36.     Xmod := X mod 4 + 1;
  37.     if (Ishade >= Dither[Xmod][Ymod]) then
  38.       gplot (X, Y, Color)
  39.     else
  40.       gplot (X, Y, 0);
  41.   end; { for X }
  42. end; { procedure DITHDRAW }
  43.  
  44.  
  45. procedure INTRPLOT (X, Y, Color: integer; Shade: real);
  46. { Plot procedure with interpolated shading }
  47. var Pcolor: integer;        { color to set pixel }
  48.     Fmod: integer;          { mod for fill pixel setting }
  49.     Ishade: integer;        { integer version of shade (0..64) for dithering }
  50.     Tshade: real;           { temp for Shade }
  51.  
  52. begin
  53.   if (Dorandom) then
  54.     Tshade := Shade + Random * Randshade
  55.   else
  56.     Tshade := Shade;
  57.   if (Ncolors >= 3) and (Mono) then begin
  58.     { Use system's colors as shades of grey }
  59.     colormod (Tshade, grSys, Color, Pcolor, Fmod);
  60.     { Now finally set the pixel to the desired shade }
  61.     shplot (X, Y, Pcolor, Fmod);
  62.   end else begin
  63.     { Use dithered shading }
  64.     Ishade := trunc (Tshade * 16.0);
  65.     dithplot (X, Y, Ishade, Color);
  66.   end; { if Ncolors... }
  67. end; { procedure INTRPLOT }
  68.  
  69.  
  70. procedure INTRDRAW (X1, X2, Y, Color: integer; Shade1, Shade2: real);
  71. { Draw procedure with interpolated shading from point 1 to point 2 }
  72. var X: integer;
  73.     Shfact: real;           { factor for shade interpolation }
  74.     Firstsh: boolean;       { flag first time through }
  75.     Shade: real;            { shade at pixel }
  76.  
  77. begin
  78.   Firstsh := TRUE;
  79.   if (X2 = X1) then
  80.     Shfact := 0.0
  81.   else
  82.     Shfact := (Shade2 - Shade1) / (X2 - X1);
  83.  
  84.   for X := X1 to X2 do begin
  85.     if (Shfact = 0.0) then
  86.       if (Firstsh) then begin
  87.         Shade := Shade1;
  88.         Firstsh := FALSE;
  89.       end else
  90.         Shade := Shade2
  91.     else
  92.       Shade := Shade1 + (X-X1) * Shfact;
  93.  
  94.     { Plot this pixel with shading }
  95.     intrplot (X, Y, Color, Shade);
  96.   end; { for X }
  97. end; { procedure INTRDRAW }
  98.